library(prophet)
library(ggplot2)
library(zoo)
library(dplyr)
df <- read.csv('example_wp_peyton_manning.csv')
df$y <- log(df$y)
m <- prophet(df, interval.width = 0.95)
## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.
## Initial log joint probability = -19.4685
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
future <- make_future_dataframe(m, periods = 365)
tail(future)
##              ds
## 3265 2017-01-14
## 3266 2017-01-15
## 3267 2017-01-16
## 3268 2017-01-17
## 3269 2017-01-18
## 3270 2017-01-19
fcst <- predict(m, future)
tail(fcst[c('ds', 'yhat', 'yhat_lower', 'yhat_upper')])
##              ds     yhat yhat_lower yhat_upper
## 3265 2017-01-14 7.835296   6.721667   8.966728
## 3266 2017-01-15 8.217122   7.104254   9.371940
## 3267 2017-01-16 8.542195   7.421200   9.694112
## 3268 2017-01-17 8.329646   7.226542   9.464802
## 3269 2017-01-18 8.162314   7.060657   9.400993
## 3270 2017-01-19 8.174268   7.063740   9.344683
plot(m, fcst)

prophet_plot_components(m, fcst)

df.cv <- cross_validation(m, horizon = 365, units = 'days')
## Initial log joint probability = -9.22773
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
## Initial log joint probability = -8.43017
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
## Initial log joint probability = -15.377
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
## Initial log joint probability = -9.8979
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
## Initial log joint probability = -13.4378
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
## Initial log joint probability = -11.0945
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
## Initial log joint probability = -53.0208
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
## Initial log joint probability = -12.2936
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
## Initial log joint probability = -17.0767
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
head(df.cv)
##           ds        y     yhat yhat_lower yhat_upper     cutoff
## 1 2011-01-22 8.409162 9.158257   8.330477   9.987801 2011-01-21
## 2 2011-01-23 8.973098 9.547139   8.744110  10.410546 2011-01-21
## 3 2011-01-24 9.550306 9.839737   9.014355  10.624930 2011-01-21
## 4 2011-01-25 8.786304 9.675732   8.882266  10.467830 2011-01-21
## 5 2011-01-26 8.608130 9.505589   8.673345  10.249089 2011-01-21
## 6 2011-01-27 8.494948 9.488983   8.658338  10.333384 2011-01-21

Calendar effects

playoffs <- data_frame(
  holiday = 'playoff',
  ds = as.Date(c('2008-01-13', '2009-01-03', '2010-01-16',
                 '2010-01-24', '2010-02-07', '2011-01-08',
                 '2013-01-12', '2014-01-12', '2014-01-19',
                 '2014-02-02', '2015-01-11', '2016-01-17',
                 '2016-01-24', '2016-02-07')),
  lower_window = 0,
  upper_window = 1
)
superbowls <- data_frame(
  holiday = 'superbowl',
  ds = as.Date(c('2010-02-07', '2014-02-02', '2016-02-07')),
  lower_window = 0,
  upper_window = 1
)
holidays <- bind_rows(playoffs, superbowls)

m2 <- prophet(df, holidays = holidays, interval.width = 0.95)
## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.
## Initial log joint probability = -19.4685
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
fcst2 <- predict(m2, future)
plot(m2, fcst2)

prophet_plot_components(m2, fcst2)

Additional regressors

nfl_sunday <- function(ds) {
  dates <- as.Date(ds)
  month <- as.numeric(format(dates, '%m'))
  as.numeric((weekdays(dates) == "Sunday") & (month > 8 | month < 2))
}
df$nfl_sunday <- nfl_sunday(df$ds)

m3 <- prophet(holidays = holidays, interval.width = 0.95)
m3 <- add_regressor(m3, 'nfl_sunday')
m3 <- fit.prophet(m3, df)
## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.
## Initial log joint probability = -19.4685
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
future$nfl_sunday <- nfl_sunday(future$ds)
fcst3 <- predict(m3, future)
plot(m3, fcst3)

prophet_plot_components(m3, fcst3)

Saturation

Prophet has damped trend too.

df <- read.csv('example_wp_R.csv')
df$y <- log(df$y)
df$cap <- 8.5

m <- prophet(df, growth = 'logistic')
## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.
## Initial log joint probability = -67.9808
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
future <- make_future_dataframe(m, periods = 1826)
future$cap <- 8.5
fcst <- predict(m, future)
plot(m, fcst)

prophet_plot_components(m, fcst)

Also works with minimum:

df$y <- 10 - df$y
df$cap <- 6
df$floor <- 1.5
future$cap <- 6
future$floor <- 1.5
m <- prophet(df, growth = 'logistic')
## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.
## Initial log joint probability = -157.241
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
fcst <- predict(m, future)
plot(m, fcst)

prophet_plot_components(m, fcst)

Outliers

## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.
## Initial log joint probability = -24.8456
## Optimization terminated normally: 
##   Convergence detected: absolute parameter change was below tolerance

Type 1:

df <- read.csv('example_wp_R_outliers1.csv')
df$y <- log(df$y)
m <- prophet(df)
## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.
## Initial log joint probability = -28.5336
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
future <- make_future_dataframe(m, periods = 1096)
forecast <- predict(m, future)
plot(m, forecast);

prophet_plot_components(m, fcst)

Need to be removed:

outliers <- (as.Date(df$ds) > as.Date('2010-01-01') & as.Date(df$ds) < as.Date('2011-01-01'))
df$y[outliers] = NA
m <- prophet(df)
## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.
## Initial log joint probability = -21.2638
## Error evaluating model log probability: Non-finite gradient.
## Error evaluating model log probability: Non-finite gradient.
## 
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
forecast <- predict(m, future)
plot(m, forecast)

prophet_plot_components(m, fcst)

Type 2:

df <- read.csv('example_wp_R_outliers2.csv')
df$y = log(df$y)
m <- prophet(df)
## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.
## Initial log joint probability = -27.5907
## Error evaluating model log probability: Non-finite gradient.
## Error evaluating model log probability: Non-finite gradient.
## 
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
future <- make_future_dataframe(m, periods = 1096)
forecast <- predict(m, future)
plot(m, forecast)

prophet_plot_components(m, fcst)

Need to be removed too:

outliers <- (as.Date(df$ds) > as.Date('2015-06-01')
             & as.Date(df$ds) < as.Date('2015-06-30'))
df$y[outliers] = NA
m <- prophet(df)
## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.
## Initial log joint probability = -24.7625
## Optimization terminated normally: 
##   Convergence detected: absolute parameter change was below tolerance
forecast <- predict(m, future)
plot(m, forecast)

prophet_plot_components(m, fcst)

Monthly data

Not that great for monthly data:

df <- read.csv("monthly-wage.csv", sep=",", stringsAsFactors=F)[-c(1:72),]
names(df) <- c('ds', 'y')
df$y <- log(df$y)
df$ds <- as.Date(as.yearmon(df$ds, format="%Y-%m"))
m <- prophet(df, interval.width = 0.95)
## Disabling weekly seasonality. Run prophet with weekly.seasonality=TRUE to override this.
## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.
## Initial log joint probability = -2.48425
## Optimization terminated normally: 
##   Convergence detected: relative gradient magnitude is below tolerance
future <- make_future_dataframe(m, periods = 36, freq = 'month')
fcst <- predict(m, future)
plot(m, fcst)

prophet_plot_components(m, fcst)

m_exp <- m
m_exp$history$y <- exp(m_exp$history$y)
fcst_exp <- fcst
fcst_exp$yhat <- exp(fcst_exp$yhat)
fcst_exp$yhat_lower <- exp(fcst_exp$yhat_lower)
fcst_exp$yhat_upper <- exp(fcst_exp$yhat_upper)
plot(m_exp, fcst_exp)